home *** CD-ROM | disk | FTP | other *** search
/ Web Designer 98 (Professional) / WebDesigner 1.0.iso / cgi2 / download.cgi-s=cookielib&c=txt&f=cookie.lib < prev    next >
Text File  |  1996-06-03  |  26KB  |  545 lines
  1. ##############################################################################
  2. # HTTP Cookie Library           Version 2.1                                  #
  3. # Copyright 1996 Matt Wright    mattw@worldwidemart.com                      #
  4. # Created 07/14/96              Last Modified 12/23/96                       #
  5. # Script Archive at:            http://www.worldwidemart.com/scripts/        #
  6. #                               Extensive Documentation found in README file.#
  7. ##############################################################################
  8. # COPYRIGHT NOTICE                                                           #
  9. # Copyright 1996 Matthew M. Wright.  All Rights Reserved.                    #
  10. #                                                                            #
  11. # HTTP Cookie Library may be used and modified free of charge by anyone so   #
  12. # long as this copyright notice and the comments above remain intact.  By    #
  13. # using this code you agree to indemnify Matthew M. Wright from any          #
  14. # liability that might arise from it's use.                                  #
  15. #                                                                            #
  16. # Selling the code for this program without prior written consent is         #
  17. # expressly forbidden.  In other words, please ask first before you try and  #
  18. # make money off of my program.                                              #
  19. #                                                                            #
  20. # Obtain permission before redistributing this software over the Internet or #
  21. # in any other medium.  In all cases copyright and header must remain intact.#
  22. ##############################################################################
  23. # Define variables for this library.                                         #
  24.  
  25.     # This is an optional variable.  If not defined, the cookie will expire  #
  26.     # when a user's session ends.                                            #
  27.     # Should be defined as: Wdy, DD-Mon-YYYY HH:MM:SS GMT                    #
  28.  
  29. $Cookie_Exp_Date = '';
  30.  
  31.     # By default this will be set to the same path as the document being     #
  32.     # described by the header which contains the cookie.                     #
  33.  
  34. $Cookie_Path = '';
  35.  
  36.     # By default this will be set to the domain host name of the server      #
  37.     # which generated the cookie response.                                   #
  38.  
  39. $Cookie_Domain = '';
  40.  
  41.     # This should be set to 0 if the cookie is safe to send across over      #
  42.     # unsecured channels.  If set to 1 the cookie will only be transferred   #
  43.     # if the communications channel with the host is a secure one. Currently #
  44.     # this means that secure cookies will only be sent to HTTPS (HTTP over   #
  45.     # SSL) servers.  According to Netscape docs at least.                    #
  46.  
  47. $Secure_Cookie = '0';
  48.  
  49.     # These are the characters which the HTTP Cookie Library will translate  #
  50.     # to url encoded (hex characters) when it sets individual or compressed  #
  51.     # cookies.  The array holds the order in which these should be           #
  52.     # translated (as we wouldn't want to translate spaces into pluses and    #
  53.     # then pluses into the URL encoded form, but rather the other way        #
  54.     # around) and the associative array holds the values to translate        #
  55.     # characters into.  The decoded set will reverse the process.  Feel free #
  56.     # to add any other characters here, but it shouldn't be necessary.       #
  57.     # This is a correction in version 2.1 which makes this library adhere    #
  58.     # more to the Netscape specifications.                                   #
  59.  
  60. @Cookie_Encode_Chars = ('\%', '\+', '\;', '\,', '\=', '\&', '\:\:', '\s');
  61.  
  62. %Cookie_Encode_Chars = ('\%',   '%25',
  63.                         '\+',   '%2B',
  64.                         '\;',   '%3B',
  65.                         '\,',   '%2C',
  66.                         '\=',   '%3D',
  67.                         '\&',   '%26',
  68.                         '\:\:', '%3A%3A',
  69.                         '\s',   '+');
  70.  
  71. @Cookie_Decode_Chars = ('\+', '\%3A\%3A', '\%26', '\%3D', '\%2C', '\%3B', '\%2B', '\%25');
  72.  
  73. %Cookie_Decode_Chars = ('\+',       ' ',
  74.                         '\%3A\%3A', '::',
  75.                         '\%26',     '&',
  76.                         '\%3D',     '=',
  77.                         '\%2C',     ',',
  78.                         '\%3B',     ';',
  79.                         '\%2B',     '+',
  80.                         '\%25',     '%');
  81. # Done                                                                       #
  82. ##############################################################################
  83.  
  84. ##############################################################################
  85. # Subroutine:    &GetCookies()                                               #
  86. # Description:   This subroutine can be called with or without arguments. If #
  87. #                arguments are specified, only cookies with names matching   #
  88. #                those specified will be set in %Cookies.  Otherwise, all    #
  89. #                cookies sent to this script will be set in %Cookies.        #
  90. # Usage:         &GetCookies([cookie_names])                                 #
  91. # Variables:     cookie_names - These are optional (depicted with []) and    #
  92. #                               specify the names of cookies you wish to set.#
  93. #                               Can also be called with an array of names.   #
  94. #                               Ex. 'name1','name2'                          #
  95. # Returns:       1 - If successful and at least one cookie is retrieved.     #
  96. #                0 - If no cookies are retrieved.                            #
  97. ##############################################################################
  98.  
  99. sub GetCookies {
  100.  
  101.     # Localize the variables and read in the cookies they wish to have       #
  102.     # returned.                                                              #
  103.  
  104.     local(@ReturnCookies) = @_;
  105.     local($cookie_flag) = 0;
  106.     local($cookie,$value);
  107.  
  108.     # If the HTTP_COOKIE environment variable has been set by the call to    #
  109.     # this script, meaning the browser sent some cookies to us, continue.    #
  110.  
  111.     if ($ENV{'HTTP_COOKIE'}) {
  112.  
  113.         # If specific cookies have have been requested, meaning the          #
  114.         # @ReturnCookies array is not empty, proceed.                        #
  115.  
  116.         if ($ReturnCookies[0] ne '') {
  117.  
  118.             # For each cookie sent to us:                                    #
  119.  
  120.             foreach (split(/; /,$ENV{'HTTP_COOKIE'})) {
  121.  
  122.                 # Split the cookie name and value pairs, separated by '='.   #
  123.  
  124.                 ($cookie,$value) = split(/=/);
  125.  
  126.                 # Decode any URL encoding which was done when the compressed #
  127.                 # cookie was set.                                            #
  128.  
  129.                 foreach $char (@Cookie_Decode_Chars) {
  130.                     $cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
  131.                     $value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
  132.                 }
  133.  
  134.                 # For each cookie to be returned in the @ReturnCookies array:#
  135.  
  136.                 foreach $ReturnCookie (@ReturnCookies) {
  137.  
  138.                     # If the $ReturnCookie is equal to the current cookie we #
  139.                     # are analyzing, set the cookie name in the %Cookies     #
  140.                     # associative array equal to the cookie value and set    #
  141.                     # the cookie flag to a true value.                       #
  142.  
  143.                     if ($ReturnCookie eq $cookie) {
  144.                         $Cookies{$cookie} = $value;
  145.                         $cookie_flag = "1";
  146.                     }
  147.                 }
  148.             }
  149.  
  150.         }
  151.  
  152.         # Otherwise, if no specific cookies have been requested, obtain all  #
  153.         # cookied and place them in the %Cookies associative array.          #
  154.  
  155.         else {
  156.  
  157.             # For each cookie that was sent to us by the browser, split the  #
  158.             # cookie name and value pairs and set the cookie name key in the #
  159.             # associative array %Cookies equal to the value of that cookie.  #
  160.             # Also set the coxokie flag to 1, since we set some cookies.      #
  161.  
  162.             foreach (split(/; /,$ENV{'HTTP_COOKIE'})) {
  163.                 ($cookie,$value) = split(/=/);
  164.  
  165.                 # Decode any URL encoding which was done when the compressed #
  166.                 # cookie was set.                                            #
  167.  
  168.                 foreach $char (@Cookie_Decode_Chars) {
  169.                     $cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
  170.                     $value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
  171.                 }
  172.  
  173.                 $Cookies{$cookie} = $value;
  174.             }
  175.             $cookie_flag = 1;
  176.         }
  177.     }
  178.  
  179.     # Return the value of the $cookie_flag, true or false, to indicate       #
  180.     # whether we succeded in reading in a cookie value or not.               #
  181.  
  182.     return $cookie_flag;
  183. }
  184.  
  185. ##############################################################################
  186. # Subroutine:    &SetCookieExpDate()                                         #
  187. # Description:   Sets the expiration date for the cookie.                    #
  188. # Usage:         &SetCookieExpDate('date')                                   #
  189. # Variables:     date - The date you wish for the cookie to expire, in the   #
  190. #                       format: Wdy, DD-Mon-YYYY HH:MM:SS GMT                #
  191. #                       Ex. 'Wed, 09-Nov-1999 00:00:00 GMT'                  #
  192. # Returns:       1 - If successful and date passes regular expression check  #
  193. #                    for format errors and the new ExpDate is set.           #
  194. #                0 - If new ExpDate was not set.  Check format of date.      #
  195. ##############################################################################
  196.  
  197. sub SetCookieExpDate {
  198.  
  199.     # If the date string is formatted as: Wdy, DD-Mon-YYYY HH:MM:SS GMT, set #
  200.     # the $Cookie_Exp_Date to the new value and return 1 to signal success.  #
  201.     # Otherwise, return 0, as the date was not successfully changed.         #
  202.     # The date can also be set null value by calling: SetCookieExpDate('').  #
  203.  
  204.     if ($_[0] =~ /^\w{3}\,\s\d{2}\-\w{3}-\d{4}\s\d{2}\:\d{2}\:\d{2}\sGMT$/ ||
  205.         $_[0] eq '') {
  206.         $Cookie_Exp_Date = $_[0];
  207.         return 1;
  208.     }
  209.     else {
  210.         return 0;
  211.     }
  212. }
  213.  
  214. ##############################################################################
  215. # Subroutine:    &SetCookiePath()                                            #
  216. # Description:   Sets the path for the cookie to be sent to.                 #
  217. # Usage:         &SetCookiePath('path')                                      #
  218. # Variables:     path - The path to which this cookie should be sent.        #
  219. #                       Ex. '/' or '/path/to/file'                           #
  220. # Returns:       Nothing.                                                    #
  221. ##############################################################################
  222.  
  223. sub SetCookiePath {
  224.  
  225.     # Set the new Cookie Path, assuming it is correct.  No error checking is #
  226.     # done.                                                                  #
  227.  
  228.     $Cookie_Path = $_[0];
  229. }
  230.  
  231. ##############################################################################
  232. # Subroutine:    &SetCookieDomain()                                          #
  233. # Description:   Sets the domain for the cookie to be sent to.  You can only #
  234. #                specify a domain within the current domain.  Must have 2 or #
  235. #                3 periods, depending on type of domain. e.g., .domain.com   #
  236. #                or .k12.co.us.                                              #
  237. # Usage:         &SetCookieDomain('domain')                                  #
  238. # Variables:     domain - The domain to set the cookie for.                  #
  239. #                         Ex. '.host.com'                                    #
  240. # Returns:       1 - If successful and value of $Cookie_Domain was set.      #
  241. #                0 - If unsuccessful and value was not changed.              #
  242. ##############################################################################
  243.  
  244. sub SetCookieDomain {
  245.  
  246.     # Following Netscape specifications, if the domain specified is one of 7 #
  247.     # top level domains, only require it to contain two periods, and if it   #
  248.     # is not, require that there be three.  If the new domain passes error   #
  249.     # checking, set the new domain and return a true value.  Otherwise,      #
  250.     # return 0.  Trying to set a domain other than the current one is futile,#
  251.     # since the browser won't allow it.  But if people may be accessing the  #
  252.     # page from www.host.xxx or host.xxx, you may wish to set it to .host.xxx#
  253.     # so that either host the access will have access to the cookie.         #
  254.  
  255.     if ($_[0] =~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i &&
  256.         $_[0] =~ /\..+\.\w{3}$/) {
  257.         $Cookie_Domain = $_[0];
  258.         return 1;
  259.     }
  260.     elsif ($_[0] !~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i &&
  261.            $_[0] =~ /\..+\..+\..+/) {
  262.         $Cookie_Domain = $_[0];
  263.         return 1;
  264.     }
  265.     else {
  266.         return 0;
  267.     }
  268. }
  269.  
  270. ##############################################################################
  271. # Subroutine:    &SetSecureCookie()                                          #
  272. # Description:   This subroutine will set the cookie to be either secure,    #
  273. #                meaning the cookie will only be passed over a secure HTTP   #
  274. #                channel, or unsecure, meaning it is safe to pass unsecured. #
  275. # Usage:         &SetSecureCookie('flag')                                    #
  276. # Variables:     flag - 0 or 1 depending whether you want it secure or not   #
  277. #                       secure.  By default, it is set to unsecure, unless   #
  278. #                       $Secure_Cookie was changed at the top.               #
  279. #                       Ex. 1                                                #
  280. # Returns:       1 - If successful and value of $Secure_Cookie was set.      #
  281. #                0 - If unsuccessful and value was not changed.              #
  282. ##############################################################################
  283.  
  284. sub SetSecureCookie {
  285.  
  286.     # If the value passed to this script is a 1 or 0, set $Secure_Cookie     #
  287.     # accordingly and return a true value.  Otherwise, return a false value. #
  288.  
  289.     if ($_[0] =~ /^[01]$/) {
  290.         $Secure_Cookie = $_[0];
  291.         return 1;
  292.     }
  293.     else {
  294.         return 0;
  295.     }
  296. }
  297.  
  298. ##############################################################################
  299. # Subroutine:    &SetCookies()                                               #
  300. # Description:   Sets one or more cookies by printing out the Set-Cookie     #
  301. #                HTTP header to the browser, based on cookie information     #
  302. #                passed to subroutine.                                       #
  303. # Usage:         &SetCookies(name1,value1,...namen,valuen)                   #
  304. # Variables:     name  - Name of the cookie to be set.                       #
  305. #                        Ex. 'count'                                         #
  306. #                value - Value of the cookie to be set.                      #
  307. #                        Ex. '3'                                             #
  308. #                n     - This is tacked on to the last of the name and value #
  309. #                        pairs in the usage instructions just to show you    #
  310. #                        you can have as many name/value pairs as you wish.  #
  311. #               ** You can specify as many name/value pairs as you wish, and #
  312. #                  &SetCookies will set them all.  Just string them out, one #
  313. #                  after the other.  You must also have already printed out  #
  314. #                  the Content-type header, with only one new line following #
  315. #                  it so that the header has not been ended.  Then after the #
  316. #                  &SetCookies call, you can print the final new line.       #
  317. # Returns:       Nothing.                                                    #
  318. ##############################################################################
  319.  
  320. sub SetCookies {
  321.  
  322.     # Localize variables and read in cookies to be set.                      #
  323.  
  324.     local(@cookies) = @_;
  325.     local($cookie,$value,$char);
  326.  
  327.     # While there is a cookie and a value to be set in @cookies, that hasn't #
  328.     # yet been set, proceed with the loop.                                   #
  329.  
  330.     while( ($cookie,$value) = @cookies ) {
  331.  
  332.         # We must translate characters which are not allowed in cookies.     #
  333.  
  334.         foreach $char (@Cookie_Encode_Chars) {
  335.             $cookie =~ s/$char/$Cookie_Encode_Chars{$char}/g;
  336.             $value =~ s/$char/$Cookie_Encode_Chars{$char}/g;
  337.         }
  338.  
  339.         # Begin the printing of the Set-Cookie header with the cookie name   #
  340.         # and value, followed by semi-colon.                                 #
  341.  
  342.         print 'Set-Cookie: ' . $cookie . '=' . $value . ';';
  343.  
  344.         # If there is an Expiration Date set, add it to the header.          #
  345.  
  346.         if ($Cookie_Exp_Date) {
  347.             print ' expires=' . $Cookie_Exp_Date . ';';
  348.         }
  349.  
  350.         # If there is a path set, add it to the header.                      #
  351.  
  352.         if ($Cookie_Path) {
  353.             print ' path=' . $Cookie_Path . ';';
  354.         }
  355.  
  356.         # If a domain has been set, add it to the header.                    #
  357.  
  358.         if ($Cookie_Domain) {
  359.             print ' domain=' . $Cookie_Domain . ';';
  360.         }
  361.  
  362.         # If this cookie should be sent only over secure channels, add that  #
  363.         # to the header.                                                     #
  364.  
  365.         if ($Secure_Cookie) {
  366.             print ' secure';
  367.         }
  368.  
  369.         # End this line of the header, setting the cookie.                   #
  370.  
  371.         print "\n";
  372.  
  373.         # Remove the first two values of the @cookies array since we just    #
  374.         # used them.                                                         #
  375.  
  376.         shift(@cookies); shift(@cookies);
  377.     }
  378. }
  379.  
  380. ##############################################################################
  381. # Subroutine:    &SetCompressedCookies                                       #
  382. # Description:   This routine does much the same thing that &SetCookies does #
  383. #                except that it combines multiple cookies into one.          #
  384. # Usage:         &SetCompressedCookies(cname,name1,value1,...,namen,valuen)  #
  385. # Variables:     cname - Name of the compressed cookie to be set.            #
  386. #                        Ex. 'CC'                                            #
  387. #                name  - Name of the individual cookie to be set.            #
  388. #                        Ex. 'count'                                         #
  389. #                value - Value of the individual cookie to be set.           #
  390. #                        Ex. '3'                                             #
  391. #                n     - This is tacked on to the last of the name and value #
  392. #                        pairs in the usage instructions just to show you    #
  393. #                        you can have as many name/value pairs as you wish.  #
  394. # Returns:       Nothing.                                                    #
  395. ##############################################################################
  396.  
  397. sub SetCompressedCookies {
  398.  
  399.     # Localize input into the compressed cookie name and the cookies to be   #
  400.     # set.                                                                   #
  401.  
  402.     local($cookie_name,@cookies) = @_;
  403.     local($cookie,$value,$cookie_value);
  404.  
  405.     # While there is a cookie and a value to be set in @cookies, that hasn't #
  406.     # yet been set, proceed with the loop.                                   #
  407.  
  408.     while ( ($cookie,$value) = @cookies ) {
  409.  
  410.         # We must translate characters which are not allowed in cookies, or  #
  411.         # which might interfere with the compression.                        #
  412.  
  413.         foreach $char (@Cookie_Encode_Chars) {
  414.             $cookie =~ s/$char/$Cookie_Encode_Chars{$char}/g;
  415.             $value =~ s/$char/$Cookie_Encode_Chars{$char}/g;
  416.         }
  417.  
  418.         # Prepare the cookie value.  If a current cookie value exists, use   #
  419.         # an ampersand (&) to separate the cookies and instead of using = to #
  420.         # separate the name and the value, use double colons (::), so it     #
  421.         # won't confuse the browser.                                         #
  422.  
  423.         if ($cookie_value) {
  424.             $cookie_value .= '&' . $cookie . '::' . $value;
  425.         }
  426.         else {
  427.             $cookie_value = $cookie . '::' . $value;
  428.         }
  429.  
  430.         # Remove the first two values of the @cookies array since we just    #
  431.         # used them.                                                         #
  432.  
  433.         shift(@cookies); shift(@cookies);
  434.     }
  435.  
  436.     # Use the &SetCookies array to set the compressed cookie and value.      #
  437.  
  438.     &SetCookies("$cookie_name","$cookie_value");
  439. }
  440.  
  441. ##############################################################################
  442. # Subroutine:    &GetCompressedCookies()                                     #
  443. # Description:   This subroutine takes the compressed cookie names, and      #
  444. #                optionally the names of specific cookies you want returned  #
  445. #                and uncompressed them, setting the values into %Cookies.    #
  446. #                Specific names of cookies are optional and if not specified #
  447. #                all cookies found in the compressed cookie will be set.     #
  448. # Usage:         &GetCompressedCookies(cname,[names])                        #
  449. # Variables:     cname - Name of the compressed cookie to be uncompressed.   #
  450. #                        Ex. 'CC'                                            #
  451. #                names - Optional names of cookies to be returned from the   #
  452. #                        compressed cookie if you don't want them all.  The  #
  453. #                        [] depict a list of optional names, don't use [].   #
  454. #                        Ex. 'count'                                         #
  455. # Returns:       1 - If successful and at least one cookie is retrieved.     #
  456. #                0 - If no cookies are retrieved.                            #
  457. ##############################################################################
  458.  
  459. sub GetCompressedCookies {
  460.  
  461.     # Localize variables used in this subroutine as well as the compressed   #
  462.     # cookie name and the cookies to retrieve from the compressed cookie.    #
  463.  
  464.     local($cookie_name,@ReturnCookies) = @_;
  465.     local($cookie_flag) = 0;
  466.     local($ReturnCookie,$cookie,$value);
  467.  
  468.     # If we can get the compressed cookie, proceed.                          #
  469.  
  470.     if (&GetCookies($cookie_name)) {
  471.  
  472.         # If there are specific cookies which we should set, rather than all #
  473.         # cookies found in the compressed cookie, then only retrieve them.   #
  474.  
  475.         if ($ReturnCookies[0] ne '') {
  476.  
  477.             # For each cookie that was found in the compressed cookie:       #
  478.  
  479.             foreach (split(/&/,$Cookies{$cookie_name})) {
  480.  
  481.                 # Split the cookie name and value pair.                      #
  482.  
  483.                 ($cookie,$value) = split(/::/);
  484.  
  485.                 # Decode any URL encoding which was done when the compressed #
  486.                 # cookie was set.                                            #
  487.  
  488.                 foreach $char (@Cookie_Decode_Chars) {
  489.                     $cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
  490.                     $value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
  491.                 }
  492.  
  493.                 # For each cookie in the specified cookies we should set,    #
  494.                 # check to see if it matches the cookie we are looking at    #
  495.                 # right now.  If so, set that cookie in the %Cookies array   #
  496.                 # and set the cookie flag to 1.                              #
  497.  
  498.                 foreach $ReturnCookie (@ReturnCookies) {
  499.                     if ($ReturnCookie eq $cookie) {
  500.                         $Cookies{$cookie} = $value;
  501.                         $cookie_flag = 1;
  502.                     }
  503.                 }
  504.             }
  505.         }
  506.  
  507.         # Otherwise, if there are no specific cookies to set, we will set    #
  508.         # all cookies we find in the compressed cookie.                      #
  509.  
  510.         else {
  511.  
  512.             # Split the compressed cookie and split the cookie name/value    #
  513.             # pairs, setting them in %Cookies.  Also set cookie flag to 1.   #
  514.  
  515.             foreach (split(/&/,$Cookies{$cookie_name})) {
  516.                 ($cookie,$value) = split(/::/);
  517.  
  518.                 # Decode any URL encoding which was done when the compressed #
  519.                 # cookie was set.                                            #
  520.  
  521.                 foreach $char (@Cookie_Decode_Chars) {
  522.                     $cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
  523.                     $value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
  524.                 }
  525.  
  526.                 $Cookies{$cookie} = $value;
  527.             }
  528.             $cookie_flag = 1;
  529.         }
  530.  
  531.         # Delete the compressed cookie from the %Cookies array.              #
  532.  
  533.         delete($Cookies{$cookie_name});
  534.     }
  535.  
  536.     # Return the cookie flag, which tells whether any cookies have been set. #
  537.  
  538.     return $cookie_flag;
  539. }
  540.  
  541. # This statement must be left in so that when perl requires this script as a #
  542. # library it will do so without errors.  This tells perl it has successfully #
  543. # required the library.                                                      #
  544.  
  545. 1;